The 640 MEG Shareware Studio 2/The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO/pascal/async4.zip/ASYNC.400

Text File | 1988-02-03 | 21KB | 566 lines

{
This  version  of Michael Quinlan's ASYNC.INC is compatible  with
IBM  PC  and  Compatibles.  It  gives  interrupt-driven  buffered
communication  capabilities to Turbo programs written for the IBM
PC.  It is heavily dependent on that hardware.

The Async_ITR routine was taken from N. Arley Dealey's Async4
procedures, to make this set of routines work with version 4.0
of turbo pascal.

The  following example routines are public domain  programs  that
have  been uploaded to our Forum on CompuServe.  As a courtesy to
our  users  that  do not have  immediate  access  to  CompuServe,
Technical Support distributes these routines free of charge.

However,  because these routines are public domain programs,  not
developed by Borland International,  we are unable to provide any
technical support or assistance using these routines. If you need
assistance   using   these   routines,    or   are   experiencing
difficulties,  we  recommend  that you log  onto  CompuServe  and
request  assistance  from the Forum members that developed  these
routines.
}

Unit Async;

Interface

Uses DOS;
{--------------------------------------------------------------}
{                        ASYNC.INC                             }
{                                                              }
{  Async Communication Routines                                }
{  by Michael Quinlan                                          }
{  with a bug fixed by Scott Herr                              }
{  with Async_ISR update to 4.0 by N. Arley Dealey substituted }
{                               by Keith Hawes                 }
{  made PCjr-compatible by W. M. Miller                        }
{  Highly dependent on the IBM PC and PC DOS 2.0               }
{                                                              }
{  based on the DUMBTERM program by CJ Dunford                 }
{  in the January 1984                                         }
{  issue of PC Tech Journal.                                   }
{                                                              }
{  Entry points:                                               }
{--------------------------------------------------------------}

Procedure Async_Init;
{--------------------------------------------------------------}
{      Performs initialization.                                }
{                                                              }
{--------------------------------------------------------------}

function Async_Open(ComPort       : Word;
                    BaudRate      : Word;
                    Parity        : Char;
                    WordSize      : Word;
                    StopBits      : Word) : Boolean;
{--------------------------------------------------------------}
{   Sets up interrupt vector, initialize the COM port for      }
{   processing, sets pointers to the buffer.  Returns FALSE    }
{   if COM                                                     }
{      port not installed.                                     }
{--------------------------------------------------------------}

Function Async_Buffer_Check(var C : Char) : Boolean;
{--------------------------------------------------------------}
{      If a character is available, returns TRUE and moves the }
{        character from the buffer to the parameter            }
{      Otherwise, returns FALSE                                }
{--------------------------------------------------------------}

Procedure Async_Send(C : Char);
{--------------------------------------------------------------}
{      Transmits the character.                                }
{--------------------------------------------------------------}

Procedure Async_Send_String(S : string);
{--------------------------------------------------------------}
{      Calls Async_Send to send each character of S.           }
{--------------------------------------------------------------}

Procedure Async_Close;
{--------------------------------------------------------------}
{    Turn off the COM port interrupts.                         }
{    will see some really strange errors and have to re-boot.  }
{--------------------------------------------------------------}

procedure Async_Change(BaudRate      : Word;
                       Parity        : Char;
                       WordSize      : Word;
                       StopBits      : Word);
{--------------------------------------------------------------}
{ change communication parameters "on the fly"                 }
{ you cannot use the BIOS routines because they drop DTR       }
{--------------------------------------------------------------}

var
  Async_Buffer_Overflow : Boolean;  { True if buffer overflow has happened }
  Async_Buffer_Used     : Word;
  Async_MaxBufferUsed   : Word;

Implementation
{ global declarations }

const
  UART_THR = $00;
      { offset from base of UART Registers for IBM PC }
  UART_RBR = $00;
  UART_IER = $01;
  UART_IIR = $02;
  UART_LCR = $03;
  UART_MCR = $04;
  UART_LSR = $05;
  UART_MSR = $06;

  I8088_IMR = $21;
       { port address of the Interrupt Mask Register }

const
  Async_Buffer_Max       = 4095;
var
  Async_Interrupt_Save   : pointer;
  Async_ExitProc_Save    : pointer;
  Async_Buffer           : Array[0..Async_Buffer_Max] of char;
  Async_Open_Flag        : Boolean;
  Async_Port             : Word; { current Open port number (1 or 2)    }
  Async_Base             : Word; { base for current open port           }
  Async_Irq              : Word; { irq for current open port            }

    { Async_Buffer is empty if Head = Tail }

  Async_Buffer_Head     : Word;    { Locn in Async_Buffer to put next char }
  Async_Buffer_Tail     : Word;    { Locn in Async_Buffer to get next char }
  Async_Buffer_NewTail  : Word;

  Async_BIOS_Port_Table : Array[1..2] of Word absolute $40:0;
    { This table is initialized by BIOS equipment determination
    code at boot time to contain the base addresses for the
    installed async adapters.  A value of 0 means "not in-
    stalled." }

const
  Async_Num_Bauds = 8;
  Async_Baud_Table : array [1..Async_Num_Bauds] of record
                                         Baud, Bits : Word
                                      end
                   = ((Baud:110;  Bits:$00),
                      (Baud:150;  Bits:$20),
                      (Baud:300;  Bits:$40),
                      (Baud:600;  Bits:$60),
                      (Baud:1200; Bits:$80),
                      (Baud:2400; Bits:$A0),
                      (Baud:4800; Bits:$C0),
                      (Baud:9600; Bits:$E0));

procedure BIOS_RS232_Init(ComPort, ComParm : Word);
{ Issue Interrupt $14 to initialize the UART   }
{ Format of ComParm:  (From IBM Tech. Ref.)    }
{                                              }
{ 7     6     5     4     3     2      1     0 }
{ --Baud Rate--     -Parity   StopBit  Word Len}
{  000 =  110       x0 = None   0 = 1  10 = 7  }
{  001 =  150       01 = Odd    1 = 2  11 = 8  }
{  010 =  300       11 = Even                  }
{  011 =  600                                  }
{  100 = 1200                                  }
{  101 = 2400                                  }
{  110 = 4800                                  }
{  111 = 9600                                  }
{                                              }

var
  Regs : registers;
begin
  with Regs do
    begin
      ax := ComParm and $00FF;  { AH=0; AL=ComParm }
      dx := ComPort;
      Intr($14, Regs)
    end;
end; { BIOS_RS232_Init }

{---------------------------------------------------------------------------}
{                      ISR - Interrupt Service Routine                      }
{---------------------------------------------------------------------------}

PROCEDURE Async_ISR ; INTERRUPT ;
{ Interrupt Service Routine }
{ Invoked when the USART has received a byte of data from the comm line     }
{ re-written 9/10/84 in machine language ; original source left as comments }
{ re-written 1987    to work under Turbo Pascal Version 4.0                 }

BEGIN { ISR }
  inline(
    $FB/                                { STI }

    { get the incoming character }
    { Async_Buffer[Async_Buffer_Head] :=
                                CHR( port[Async_Base + DG1_USART_Data] ) ;  }
    $8B/$16/Async_Base/                       { MOV DX,Base }
    $EC/                                      { IN AL,DX }
    $8B/$1E/Async_Buffer_Head/                { MOV BX,BufferHead }
    $88/$87/Async_Buffer/                     { MOV Buffer[BX],AL }

    { Async_Buffer_NewHead := SUCC( Async_Buffer_Head ) ;           }
    $43/                                      { INC BX }

    { IF Async_Buffer_NewHead > Async_Buffer_Max
            THEN Async_Buffer_NewHead := 0 ; }
    $81/$FB/Async_Buffer_Max/                 { CMP BX,BufferMax }
    $7E/$02/                                  { JLE L001 }
    $33/$DB/                                  { XOR BX,BX }

    { IF Async_Buffer_NewHead = Async_Buffer_Tail THEN Overflow := TRUE }
    {L001:}
    $3B/$1E/Async_Buffer_Tail/                { CMP BX,Async_Buffer_Tail }
    $75/$08/                                  { JNE L002 }
    $C6/$06/Async_Buffer_Overflow/$01/        { MOV Overflow,1 }
    $90/                                      { NOP generated by assembler }
    $EB/$16/                                  { JMP SHORT L003 }
    { ELSE BEGIN                                                    }
    {   Async_Buffer_Head := Async_Buffer_NewHead ;                 }
    {   Async_Buffer_Used  := SUCC( Async_Buffer_Used ) ;           }
    {   IF Async_Buffer_Used > Async_MaxBufferUsed THEN             }
    {     Async_MaxBufferUsed := Async_BufferUsed                   }
    {   END ;                                                       }
    {L002:}
    $89/$1E/Async_Buffer_Head/                { MOV BufferHead,BX }
      $FF/$06/Async_Buffer_Used/              { INC Async_BufferUsed }
      $8B/$1E/Async_Buffer_Used/              { MOV BX,Async_BufferUsed }
      $3B/$1E/Async_MaxBufferUsed/            { CMP BX,Async_MaxBufferUsed }
      $7E/$04/                                { JLE L003 }
      $89/$1E/Async_MaxBufferUsed/            { MOV Async_MaxBufferUsed,BX }
    {L003:}

    $FA/                                      { CLI }

    { issue non-specific EOI }
    { port[$20] := $20 ;                                                }
    $B0/$20/                                  { MOV AL,20h }
    $E6/$20                                   { OUT 20h,AL }
    )
  END { Async_ISR } ;


procedure Async_Init;
{ initialize variables }
begin
  Async_Open_Flag := FALSE;
  Async_Buffer_Overflow := FALSE;
  Async_Buffer_Used := 0;
  Async_MaxBufferUsed := 0;
end; { Async_Init }

procedure Async_Close;
{ reset the interrupt system when UART interrupts
  no longer needed }
var
  i, m : Word;
begin
  if Async_Open_Flag then
    begin

      { disable the IRQ on the 8259 }
      Inline($FA);                              { disable interrupts }
      i := Port[I8088_IMR];        { get the interrupt mask register }
      m := 1 shl Async_Irq;         { set mask to turn off interrupt }
      Port[I8088_IMR] := i or m;

      { disable the 8250 data ready interrupt }
      Port[UART_IER + Async_Base] := 0;

      { disable OUT2 on the 8250 }
      Port[UART_MCR + Async_Base] := 0;
      Inline($FB);         { enable interrupts }

      { re-initialize our data areas so
        we know the port is closed }
      Async_Open_Flag := FALSE;

{Version 4 support by Keith Hawes next 2 lines}
      SetIntVec( Async_IRQ + 8, Async_Interrupt_Save ); {restore old interupt}
      ExitProc := Async_ExitProc_Save;                {restore ExirProc chain}
    end
end; { Async_Close }

function Async_Open(ComPort       : Word;
                    BaudRate      : Word;
                    Parity        : Char;
                    WordSize      : Word;
                    StopBits      : Word) : Boolean;
{ open a communications port }
var
  ComParm : Word;
  i, m : Word;
begin
  if Async_Open_Flag then Async_Close;

  if (ComPort = 2) and (Async_BIOS_Port_Table[2] <> 0) then
    Async_Port := 2
  else
    Async_Port := 1;  { default to COM1 }
  Async_Base := Async_BIOS_Port_Table[Async_Port];
  Async_Irq := Hi(Async_Base) + 1;

  if (Port[UART_IIR + Async_Base] and $00F8) <> 0 then
    Async_Open := FALSE
  else
    begin
      Async_Buffer_Head := 0;
      Async_Buffer_Tail := 0;
      Async_Buffer_Overflow := FALSE;

  { Build the ComParm for RS232_Init }
  { See Technical Reference Manual for description }

      ComParm := $0000;

  { Set up the bits for the baud rate }
      i := 0;
      repeat
        i := i + 1
      until (Async_Baud_Table[i].Baud = BaudRate)
              or (i = Async_Num_Bauds);
      ComParm := ComParm or Async_Baud_Table[i].Bits;

      if Parity in ['E', 'e'] then ComParm := ComParm or $0018
      else if Parity in ['O', 'o'] then
           ComParm := ComParm or $0008
      else ComParm := ComParm or $0000;  { default to No parity }
      if WordSize = 7 then ComParm := ComParm or $0002
      else ComParm := ComParm or $0003;  { default to 8 data bits }

      if StopBits = 2 then ComParm := ComParm or $0004
      else ComParm := ComParm or $0000;  { default to 1 stop bit }

      { use the BIOS COM port initialization routine
        to save typing the code }

      BIOS_RS232_Init(Async_Port - 1, ComParm);
      GetIntVec( Async_Irq + 8, Async_Interrupt_Save ); {Version 4 support KH}
      Async_ExitProc_Save := ExitProc;       {Version 4 support by Keith Hawes}
      ExitProc := @Async_Close;              {Version 4 support by Keith Hawes}
      SetIntVec( Async_Irq + 8, @Async_Isr );{Version 4 support by Keith Hawes}

{ read the RBR and reset any possible pending error conditions
  first turn off the Divisor Access Latch Bit to allow
  access to RBR, etc. }

      Inline($FA);  { disable interrupts }

      Port[UART_LCR + Async_Base] :=
              Port[UART_LCR + Async_Base] and $7F;
      { read the Line Status Register to reset any
        errors it indicates }
      i := Port[UART_LSR + Async_Base];
      { read the Receiver Buffer Register in case
        it contains a character }
      i := Port[UART_RBR + Async_Base];

      { enable the irq on the 8259 controller }
      i := Port[I8088_IMR];  { get the interrupt mask register }
      m := (1 shl Async_Irq) xor $00FF;
      Port[I8088_IMR] := i and m;

      { enable the data ready interrupt on the 8250 }
      Port[UART_IER + Async_Base] := $01;
      { enable data ready interrupt }

      { enable OUT2 on 8250 }
      i := Port[UART_MCR + Async_Base];
      Port[UART_MCR + Async_Base] := i or $08;
      Inline($FB); { enable interrupts }
      Async_Open_Flag := TRUE;  { bug fix by Scott Herr }
      Async_Open := TRUE
    end;
end; { Async_Open }

function Async_Buffer_Check(var C : Char) : Boolean;
{ see if a character has been received; return it if yes }
begin
  if Async_Buffer_Head = Async_Buffer_Tail then
    Async_Buffer_Check := FALSE
  else
    begin
      C := Async_Buffer[Async_Buffer_Tail];
      Async_Buffer_Tail := Async_Buffer_Tail + 1;
      if Async_Buffer_Tail > Async_Buffer_Max then
        Async_Buffer_Tail := 0;
      Async_Buffer_Used := Async_Buffer_Used - 1;
      Async_Buffer_Check := TRUE
    end
end; { Async_Buffer_Check }

procedure Async_Send(C : Char);
{ transmit a character }
var
  i, m, counter : Word;
begin
  Port[UART_MCR + Async_Base] := $0B; { turn on OUT2, DTR, and RTS }

  { wait for CTS }
  counter := MaxInt;
  while (counter <> 0) and
        ((Port[UART_MSR + Async_Base] and $10) = 0) do
    counter := counter - 1;

  { wait for Transmit Hold Register Empty (THRE) }
  if counter <> 0 then counter := MaxInt;
  while (counter <> 0) and
        ((Port[UART_LSR + Async_Base] and $20) = 0) do
    counter := counter - 1;
  if counter <> 0 then
    begin
      { send the character }
      Inline($FA); { disable interrupts }
      Port[UART_THR + Async_Base] := Ord(C);
      Inline($FB) { enable interrupts }
    end
  else
    writeln('<<<TIMEOUT>>>');
end; { Async_Send }

procedure Async_Send_String(S : String);
{ transmit a string }
var
  i : Word;
begin
  for i := 1 to length(S) do
    Async_Send(S[i])
end; { Async_Send_String }

procedure Async_Change(BaudRate      : Word;
                       Parity        : Char;
                       WordSize      : Word;
                       StopBits      : Word);
{ change communication parameters "on the fly" }
{ you cannot use the BIOS routines because they drop DTR }

const num_bauds = 15;
    divisor_table : array [1..num_bauds] of record
                                            baud, divisor : Word
                                          end
       = ((baud:50;  divisor:2304),
          (baud:75;  divisor:1536),
          (baud:110; divisor:1047),
          (baud:134; divisor:857),
          (baud:150; divisor:768),
          (baud:300; divisor:384),
          (baud:600; divisor:192),
          (baud:1200; divisor:96),
          (baud:1800; divisor:64),
          (baud:2000; divisor:58),
          (baud:2400; divisor:48),
          (baud:3600; divisor:32),
          (baud:4800; divisor:24),
          (baud:7200; divisor:16),
          (baud:9600; divisor:12));

var i : Word;
    dv  : Word;
    lcr : Word;
begin

  { Build the Line Control Register and find
    the divisor (for the baud rate) }

  { Set up the divisor for the baud rate }
  i := 0;
  repeat
    i := i + 1
  until (Divisor_Table[i].Baud = BaudRate) or (i = Num_Bauds);
  dv  := Divisor_Table[i].divisor;

  lcr := 0;
  case Parity of
    'E' : lcr := lcr or $18;  { even parity }
    'O' : lcr := lcr or $08;  { odd parity }
    'N' : lcr := lcr or $00;  { no parity }
    'M' : lcr := lcr or $28;  { Mark parity }
    'S' : lcr := lcr or $38;  { Space parity }
  else
    lcr := lcr or $00;  { default to no parity }
  end;

  case WordSize of
    5 : lcr := lcr or $00;
    6 : lcr := lcr or $01;
    7 : lcr := lcr or $02;
    8 : lcr := lcr or $03;
  else
    lcr := lcr or $03;  { default to 8 data bits }
  end;

  if StopBits = 2 then lcr := lcr or $04
  else lcr := lcr or $00;  { default to 1 stop bit }

  lcr := lcr and $7F;   { make certain the DLAB is off }

  Inline($FA);  { disable interrupts }

  { turn on DLAB to access the divisor }
  Port[UART_LCR + Async_Base] := Port[UART_LCR + Async_Base] or $80;

  { set the divisor }
  Port[Async_Base] := Lo(dv);
  Port[Async_Base + 1] := Hi(dv);

  { turn off the DLAB and set the new comm. parameters }
  Port[UART_LCR + Async_Base] := lcr;

  Inline($FB);  { enable interrupts }

end; { Async_Change }
end.

*****************************************************************************
  Test Program.... place in a separate file and compile with the Make option

program tty;
uses crt,async;
var
  c : char;

begin
  Async_Init;  { initialize variables }
  if not Async_Open(2, 1200, 'E', 7, 1) then  {open communications port}
    begin
      writeln('**ERROR: Async_Open failed');
      halt
    end;

  writeln('TTY Emulation begins now...');
  writeln('Press ESC key to terminate...');

  repeat
    if Async_Buffer_Check(c) then
      case c of
        #000 : ;  { strip incoming nulls }
        #010 : ;  { strip incoming line feeds }
        #012 : ClrScr;  { clear screen on a form feed }
        #013 : Writeln  { handle carriage return as CR/LF }
      else
        write(c)  { else write incoming char to the screen }
      end; { case }
    if KeyPressed then
      begin
        c := readkey;
        if c = #027 then  { Trap Esc Key }
          begin
            Async_Close;   { reset the interrupt system, etc. }
            Writeln('End of TTY Emulation...');
            halt;          { terminate the program }
          end
        else
          Async_Send(c)
      end;
  until FALSE;
end.

*****************************************************************************